home *** CD-ROM | disk | FTP | other *** search
/ Varios Español / Varios Español.iso / DBASE5 / SAMPLES.ZIP / MOV_CTAS.FRG < prev    next >
Text File  |  1994-10-12  |  7KB  |  299 lines
  1. * Programa...........: C:\DBASE20\EJEMPLOS\MOV_CTAS.FRG
  2. * Fecha..............: 2-23-93
  3. * Versión............: dBASE IV, Informes 2.0
  4. *
  5. * Notas:
  6. * ------
  7. * Antes de ejecutar este procedimiento con el mandato DO
  8. * es necesario usar LOCATE, pues la sentencia CONTINUE
  9. * está en el bucle principal.
  10. *
  11. *-- Parámetros
  12. PARAMETERS gl_noeject, gl_plain, gl_summary, gc_heading, gc_extra
  13. ** Los tres primeros parámetros son de tipo lógico
  14. ** El cuarto es una serie y el quinto es un parámetro adicional.
  15. PRIVATE _peject, _wrap
  16.  
  17. *-- Comprueba si no se ha encontrado ningún registro
  18. IF EOF() .OR. .NOT. FOUND()
  19.    RETURN
  20. ENDIF
  21.  
  22. *-- Desactiva la justificación entre márgenes.
  23. _wrap=.F.
  24.  
  25. IF _plength < (_pspacing * 4 + 1) + (_pspacing * 3 + 1) + 2
  26.    SET DEVICE TO SCREEN
  27.    DEFINE WINDOW gw_report FROM 7,17 TO 11,62 DOUBLE
  28.    ACTIVATE WINDOW gw_report
  29.    @ 0,1 SAY "Aumente la longitud de página del informe."
  30.    @ 2,1 SAY "Pulse una tecla ..."
  31.    x=INKEY(0)
  32.    DEACTIVATE WINDOW gw_report
  33.    RELEASE WINDOW gw_report
  34.    RETURN
  35. ENDIF
  36.  
  37. _plineno=0          && pone el número de líneas a cero
  38. *-- Parámetro NOEJECT
  39. IF gl_noeject
  40.    IF _peject="BEFORE"
  41.       _peject="NONE"
  42.    ENDIF
  43.    IF _peject="BOTH"
  44.       _peject="AFTER"
  45.    ENDIF
  46. ENDIF
  47.  
  48. *-- Establecimiento de entorno
  49. ON ESCAPE DO Prnabort
  50. IF SET("TALK")="ON"
  51.    SET TALK OFF
  52.    gc_talk="ON"
  53. ELSE
  54.    gc_talk="OFF"
  55. ENDIF
  56. gc_space=SET("SPACE")
  57. SET SPACE OFF
  58. gc_time=TIME()      && Tiempo del sistema para el campo predefinido
  59. gd_date=DATE()      && Fecha del sistema  "    "    "     "
  60. gl_fandl=.F.        && indicador de primera y última página
  61. gl_prntflg=.T.      && indicador de continuar impresión
  62. gl_widow=.T.        && indicador de comprobar apartados viudos
  63. gn_length=LEN(gc_heading)  && almacena la longitud del encabezamiento (HEADING)
  64. gn_level=2          && apartado actual en proceso
  65. gn_page=_pageno     && captura el número de página actual
  66. gn_pspace=_pspacing && captura el interlineado de la página impresa actual
  67.  
  68.  
  69. *-- Activa el procedimiento para el salto de página
  70. gn_atline=_plength - (_pspacing * 3 + 1)
  71. ON PAGE AT LINE gn_atline EJECT PAGE
  72.  
  73. *-- Imprime el informe
  74.  
  75. PRINTJOB
  76.  
  77. *-- Inicializa las variables del resumen.
  78. r_msum1=0
  79. r_msum2=0
  80.  
  81. IF gl_plain
  82.    ON PAGE AT LINE gn_atline DO Pgplain
  83. ELSE
  84.    ON PAGE AT LINE gn_atline DO Pgfoot
  85. ENDIF
  86.  
  87. DO Pghead
  88.  
  89. gl_fandl=.T.        && comienzo de la primera página física
  90.  
  91. DO Rintro
  92.  
  93. *-- Bucle de fichero
  94. DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
  95.    gn_level=0
  96.    *-- Cuerpo del informe
  97.    IF gl_summary
  98.       DO Upd_Vars
  99.    ELSE
  100.       DO __Detail
  101.    ENDIF
  102.    gl_widow=.T.         && activa la comprobación de apartados viudos
  103.    CONTINUE
  104. ENDDO
  105.  
  106. IF gl_prntflg
  107.    DO Rsumm
  108.    IF _plineno <= gn_atline
  109.       EJECT PAGE
  110.    ENDIF
  111. ELSE
  112.    DO Rsumm
  113.    DO Reset
  114.    RETURN
  115. ENDIF
  116.  
  117. ON PAGE
  118.  
  119. ENDPRINTJOB
  120.  
  121. DO Reset
  122. RETURN
  123. * EOP: C:\DBASE20\EJEMPLOS\MOV_CTAS.FRG
  124.  
  125. *-- Actualiza los campos resumen y/o los campos calculados.
  126. PROCEDURE Upd_Vars
  127. *-- Suma
  128. r_msum1=r_msum1+BALANC_ANT
  129. *-- Suma
  130. r_msum2=r_msum2+IMP_CTA
  131. RETURN
  132. * EOP: Upd_Vars
  133.  
  134. *-- Desactiva el indicador para salir del bucle DO WHILE cuando se pulse ESC
  135. PROCEDURE Prnabort
  136. gl_prntflg=.F.
  137. RETURN
  138. * EOP: Prnabort
  139.  
  140. PROCEDURE Pghead
  141. PRIVATE ll_heading, ln_width
  142. ll_heading = .T.
  143. ln_width = _rmargin - _lmargin
  144. ?
  145. *-- Parámetros para imprimir la cabecera - si no cabe en una línea
  146. *-- El valor añadido a gn_length es la última columna de la primera línea dos veces
  147. IF .NOT. gl_plain .AND. gn_length + 156 > ln_width
  148.    ?? gc_heading FUNCTION "I;V"+LTRIM(STR(ln_width))
  149.    ?
  150.    ll_heading = .F.
  151. ENDIF
  152.  
  153. ?? IIF(gl_plain,'',gd_date) AT 0,;
  154.  "PAGINA  " AT 66,;
  155.  IIF(gl_plain,'',_pageno) PICTURE "999" 
  156.  
  157. *-- Parámetros para imprimir la cabecera - si cabe en la primera línea
  158. IF .NOT. gl_plain .AND. gn_length > 0 .AND. ll_heading
  159.    ?? " "
  160.    ?? gc_heading FUNCTION "I;V"+LTRIM(STR(ln_width-(_pcolno*2)))
  161. ENDIF
  162. ?
  163. ?
  164. ?
  165. RETURN
  166. * EOP: Pghead
  167.  
  168. PROCEDURE Rintro
  169. ?
  170. DEFINE BOX FROM 23 TO 57 HEIGHT 4 DOUBLE
  171. ?
  172. ?? "A-T INDUSTRIAS DEL MUEBLE" STYLE "B" AT 28
  173. ?
  174. ?? "INFORME DE CUENTAS PENDIENTES" STYLE "B" AT 26
  175. ?
  176. ?
  177. ?
  178. RETURN
  179. * EOP: Rintro
  180.  
  181. PROCEDURE __Detail
  182. IF 12 * gn_pspace < gn_atline - (_pspacing * 4 + 1)
  183.    IF gl_widow .AND. _plineno+12 * gn_pspace > gn_atline + 1
  184.       EJECT PAGE
  185.    ENDIF
  186. ENDIF
  187. DO Upd_Vars
  188. ?? ;
  189. "──────────────────────────────────────────────────────────────────────";
  190. + "───────";
  191. AT 0
  192. ?
  193. ?? "FACTURA Nº: " STYLE "B" AT 0,;
  194.  Num_fac FUNCTION "T" STYLE "B" ,;
  195.  "FECHA: " STYLE "B" AT 62,;
  196.  Fecha_fac STYLE "B" 
  197. ?
  198. ?? "CLIENTE Nº: " AT 0,;
  199.  Cod_cli FUNCTION "T" 
  200. ?
  201. ?? "ULTIMA FACTURA Nº: " AT 3,;
  202.  Num_ultfac FUNCTION "T" ,;
  203.  "ENVIADA: " AT 36,;
  204.  Fch_ultfac 
  205. ?
  206. ?? "ULTIMA CUENTA:     " AT 3,;
  207.  Imp_ultcta PICTURE "99,999,999" ,;
  208.  "₧" AT 33
  209. ?
  210. ?? "ULTIMO PAGO:       " AT 3,;
  211.  Imp_ultpag PICTURE "99,999,999" 
  212. ?
  213. ?? "----------" AT 22
  214. ?
  215. ?? "BALANCE ANTERIOR:  " AT 3,;
  216.  Balanc_ant PICTURE "99,999,999" ,;
  217.  "₧" AT 33
  218. ?
  219. ?? "IMPORTE FACTURA:   " AT 3,;
  220.  Imp_fac PICTURE "99,999,999" ,;
  221.  "COMENTARIO: " AT 36,;
  222.  Comentario FUNCTION "T" 
  223. ?
  224. ?? "==========" AT 22
  225. ?
  226. ?? "IMPORTE CUENTA:   " AT 3,;
  227.  Imp_cta PICTURE "99,999,999" AT 22,;
  228.  "₧" AT 33,;
  229.  "NOTAS: " AT 36,;
  230.  Notas FUNCTION "T" 
  231. ?
  232. ?
  233. RETURN
  234. * EOP: __Detail
  235.  
  236. PROCEDURE Rsumm
  237. ?
  238. ?? ;
  239. "══════════════════════════════════════════════════════════════════════";
  240. + "═══════";
  241. AT 0
  242. ?
  243. ?? "IMPORTE TOTAL DE BALANCES ANTERIORES:  " AT 0,;
  244.  r_msum1 PICTURE "99,999,999" 
  245. ?
  246. ?? "IMPORTE TOTAL DE CUENTAS PENDIENTES:   " AT 0,;
  247.  r_msum2 PICTURE "99,999,999" 
  248. ?
  249. ?? ;
  250. "══════════════════════════════════════════════════════════════════════";
  251. + "═══════";
  252. AT 0
  253. gl_fandl=.F.        && terminada la última página
  254. ?
  255. RETURN
  256. * EOP: Rsumm
  257.  
  258. PROCEDURE Pgfoot
  259. PRIVATE _box, _pspacing
  260. gl_widow=.F.         && desactiva la comprobación de líneas viudas
  261. _pspacing=1
  262. ?
  263. IF .NOT. gl_plain
  264.    _pspacing=gn_pspace
  265.    ?
  266.    ?? "PREPARADO POR EL DEPARTAMENTO FINANCIERO" AT 22
  267.    ?
  268. ENDIF
  269. EJECT PAGE
  270. *-- comprueba si el número de página es mayor que el de la última página
  271. IF _pageno > _pepage
  272.    GOTO BOTTOM
  273.    SKIP
  274.    gn_level=0
  275. ENDIF
  276. IF .NOT. gl_plain .AND. gl_fandl
  277.    _pspacing=gn_pspace
  278.    DO Pghead
  279. ENDIF
  280. RETURN
  281. * EOP: Pgfoot
  282.  
  283. *-- Proceso de los saltos de página cuando se usa la opción PLAIN
  284. PROCEDURE Pgplain
  285. PRIVATE _box
  286. EJECT PAGE
  287. RETURN
  288. * EOP: Pgplain
  289.  
  290. *-- Restaura el entorno de dBASE previo a la impresión del informe
  291. PROCEDURE Reset
  292. SET SPACE &gc_space.
  293. SET TALK &gc_talk.
  294. ON ESCAPE
  295. ON PAGE
  296. RETURN
  297. * EOP: Reset
  298.  
  299.